perm filename TAK.LSP[F78,JMC] blob sn#396687 filedate 1978-11-22 generic text, type T, neo UTF8

(DEFUN QTAK (U) 
       (COND ((EQUAL (CAR U) 1.) (CADR U))
	     (T ((LAMBDA (W) ((LAMBDA (X Y Z) 
			       (COND
				((NOT (LESSP Y X)) Y)
				(T (QTAK (LIST 2.
					       (LIST 2.
						     (LIST 1.
							   (SUB1 X))
						     (LIST 1. Y)
						     Z)
					       (LIST 2.
						     (LIST 1.
							   (SUB1 Y))
						     Z
						     (LIST 1. X))
					       (LIST 3.
						     (LIST 1. X)
						     (LIST 1. Y)
						     Z))))))
			      (CAR W)
			      (CADR W)
			      (CADDR W)))
		 (COND ((EQUAL (CAR U) 2.)
			(LIST (QTAK (CADR U))
			      (QTAK (CADDR U))
			      (CADDDR U)))
		       (T (LIST (SUB1 (QTAK (CADDDR U)))
				(QTAK (CADR U))
				(CADDR U)))))))) 


(DEFUN QQTAK (X Z) (QTAK (LIST 2 (LIST 1 X) (LIST 1 0) (LIST 1 Z))))